home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / BINDEC.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-08-08  |  3.8 KB  |  100 lines
  1. 10░ '+-------------------------------------------------------------+
  2. 101 '| Program..: BINDEC.BAS                                       |
  3. 102 '| Author...: Steve Manes; modified by Luis A. Castro          | 
  4. 103 '| Date.....: August 1, 1983                                   |
  5. 104 '| Notes....: Converts a binary file to a dBASE II decimal     |
  6. 105 '|            POKE sequence.                                   |
  7. 106 '+-------------------------------------------------------------+
  8. 107 '
  9. 200 DEFINT A-Z
  10. 250 '
  11. 300 'Get input and output filenames.
  12. 305 CLS
  13. 310 LOCATE 2, 1 :PRINT "Binary to hexadecimal file conversion"
  14. 320 LOCATE 5, 1 :INPUT "Source filename (with EXT.) - ",FILEIN$
  15. 330 LOCATE 6, 1 :INPUT "Output filename (.DTX)      - ",FILEOUT$
  16. 340 IF FILEIN$="" OR FILEOUT$="" THEN SYSTEM
  17. 345 PRINT
  18. 350 '
  19. 355 'Open input file.
  20. 360 OPEN "R", #1, FILEIN$, 1
  21. 370 FIELD #1, 1 AS ONEBYTE$
  22. 380 COUNT = 0
  23. 400 IF INSTR( "EXE,exe", RIGHT$(FILEIN$,3) ) <> 0 THEN ELSE 500
  24. 410    'Get file offset from EXE file header and initialize pointer.
  25. 415    'Get offset to program data.
  26. 420    'COUNT will equal the input file byte offset.
  27. 425    GET #1, 9
  28. 430    LOW.ORDER.BYTE = ASC( ONEBYTE$ )
  29. 435    GET #1, 10
  30. 440    HIGH.ORDER.BYTE = ASC( ONEBYTE$ )
  31. 445    COUNT = INT( (LOW.ORDER.BYTE * 16) + (HIGH.ORDER.BYTE * 4096) ) + 1
  32. 450    GOTO 700
  33. 500 'ELSE
  34. 510 IF INSTR( "COM,com", RIGHT$(FILEIN$,3) ) <> 0 THEN ELSE 600
  35. 520    'COM files have no program header.
  36. 530    'Initialize pointer to first byte.
  37. 540    COUNT = 1
  38. 550    GOTO 700
  39. 600 'ELSE
  40. 620    PRINT
  41. 630    PRINT "Can only convert COM or EXE type files."
  42. 640    CLOSE 1
  43. 650    END
  44. 700 'ENDIF
  45. 710 '
  46. 720 'Force .DTX extension to filename and open output file.
  47. 730 POSITION = INSTR( FILEOUT$, "." )
  48. 740 IF POSITION > 0 THEN FILEOUT$ = LEFT$( FILEOUT$, POSITION - 1 )
  49. 750 FILEOUT$ = FILEOUT$ + ".DTX"
  50. 810 OPEN "R", #2, FILEOUT$, 80
  51. 820 FIELD #2, 80 AS RESULT$
  52. 830 '
  53. 900 FALSE = 0
  54. 905 TRUE = NOT FALSE
  55. 910 CHARCOUNT = 0    'Number of chars in current string.
  56. 930 DECSTRING$ = ""     'ASCII decimal string.
  57. 940 RECNUM = 1        'Output file record number.
  58. 950 '
  59. 1030 TOTAL.BYTES = LOF(1)
  60. 2000 WHILE COUNT <= TOTAL.BYTES
  61. 2010    GET #1, COUNT
  62. 2020    BYTE = ASC( ONEBYTE$ )     'ASCII value of input byte.
  63. 2120    BYTE$ = HEX$( BYTE )   'Format leading zero.
  64. 2130    IF BYTE < 16 THEN BYTE$ = "0" + BYTE$
  65. 2210    BYTE$ = BYTE$ + "   "
  66. 2320    DEC$ = MID$( STR$( BYTE ), 2 )        'Strip leading blank in STR$
  67. 2330    DEC$ = STRING$(3-LEN(DEC$),"0")+DEC$+","+" "  'Format decimal byte
  68. 2340    DECSTRING$ = DECSTRING$ + DEC$        'Add it to DECSTRING$
  69. 2350    CHARCOUNT = CHARCOUNT + 1      'Increment character counter
  70. 2360    IF (CHARCOUNT MOD 16) = 0 THEN GOSUB 7000  'DUMP_STRING
  71. 2370    COUNT = COUNT + 1    'Increment input byte counter
  72. 2400 WEND
  73. 2410 '
  74. 3000 'Remove last comma in DECSTRING$.
  75. 3020 POSITION = ( CHARCOUNT MOD 16 )
  76. 3050 IF POSITION<>0 THEN DECSTRING$ = MID$(DECSTRING$,1,LEN(DECSTRING$)-2)
  77. 3100 DECSTRING$ = DECSTRING$ + STRING$( 80 - LEN(DECSTRING$), 26 )  'pad.
  78. 3200 GOSUB 7000  'DUMP_STRING
  79. 3210 LSET RESULT$ = STRING$( 80, 26 )    'A little extra padding.
  80. 3220 PUT #2, RECNUM
  81. 3230 CLOSE 1, 2
  82. 3250 LOCATE 22, 1 :PRINT "... done "
  83. 4000 SYSTEM
  84. 4010 '
  85. 4020 '
  86. 7000 'Subroutine: FORMAT_STRINGS_AND_PRINT_ON_SCREEN
  87. 7050 '+--------------------------------------------+
  88. 7110    DECSTRING$ = MID$( DECSTRING$, 1, LEN(DECSTRING$) - 2 )
  89. 7120    ROW = (RECNUM MOD 16) + 5
  90. 7130    LOCATE ROW + 1, 1  :PRINT STRING$( 80, " " );
  91. 7150    LOCATE ROW, 1      :PRINT DECSTRING$;
  92. 7220    DECSTRING$ = DECSTRING$ + CHR$(13) + CHR$(10)  'Add CR/LF.
  93. 7230    LSET RESULT$ = DECSTRING$
  94. 7240    PUT #2, RECNUM      'Write decimal string to .DTX file
  95. 7320    DECSTRING$ = ""
  96. 7330    RECNUM = RECNUM + 1    'Increment output record number.
  97. 7340 RETURN
  98. 7400 '
  99. 9000 'EOF Bindec.bas
  100.